"Higher Order Perl" ist ein Buch von Mark Jason Dominus (2005), in dem er sehr interessante Programmiertechniken erläutert.

Ein echter Fortran Programmierer programmiert Fortran in jeder Sprache

 1:  # C / C++
 2:  for (my $i = 0; $i++; 10 > $i) {
 3:      print "Hello World\n";
 4:  }
 5:  
 6:  # Perl
 7:  print "Hello World\n" x 10;

• C

• Shell

• sed, awk

• Syntax

   1:    {} [] ->

• libc / Funktionsaufrufe

   1:    printf getc socket ...

Perl und Lisp:

• Automatische Speicherverwaltung

• Dynamischer Zugriff auf die Symboltabelle

• Der gesamte Sprachumfang ist immer vorhanden (eval)

• Funktionen als Werte erster Klasse

• Seit 1957

• Sehr von Lisp überzeugt

• Komische Sprache

• "Elfenbeinturm"

Lisp has the visual appeal of fingernail clippings in oatmeal -- Larry Wall

• Referenzen

• Rekursion

• Dynamischer Zugriff auf die Symboltabelle

  - Ein Cache-Mechanismus, der ohne Änderung des Codes auskommt

• Automatische Speicherverwaltung

  - Fast zu trivial

  - aber nur fast

• Funktionen als Werte erster Klasse

  - map, grep

  - Callbacks

  - Iteratoren

  - unendliche Listen

• Skalare: my $ref = \$foo

   1:  print $$ref;

• Arrays: my $ref = [ 'foo', 'bar', 'baz ]

   1:  push @$ref, "Noch ein Element";
   2:  print $ref->[0];

• Hashes: my $ref = { sprache => 'en-DE', name => Max }

   1:  %$ref = ( name => 'Max', sprache => 'de-DE' );
   2:  print "Hallo, ",$ref->{name};

• Code: my $ref = sub { print "Hallo $_[0]!\n"; }

   1:  $ref->("Max");

Rekursiv, adj.: Siehe rekursiv

Klassische Beispiele:

• Anzahl von Permutationen

• Fibonacci-Funktion

• 1. Jede Zahl ist entweder "gerade" oder "ungerade".

• 2. Eine Zahl n heißt "gerade", wenn n-1 ungerade ist.

• 3. Eine Zahl n heißt "ungerade", wenn n-1 gerade ist.

• 4. 0 ist eine gerade Zahl.

Beispiel: Ist fünfhundertdreiundvierzig gerade?

• 543 -> 542 -> ... -> 1 -> 0:

• 0 ist gerade

• 1 ist ungerade

• ...

• Fünfhundertdreiundvierzig ist ungerade

Die Regeln lassen sich direkt in Perl Code übersetzen:

 1:  sub gerade {
 2:      my $zahl = $_[0];
 3:      # 0 ist eine gerade Zahl.
 4:      return 1
 5:          if ($zahl == 0);
 6:      # Eine Zahl n heißt "gerade", wenn n-1 ungerade ist.
 7:      return 1
 8:          if (! gerade($zahl-1));
 9:      # Eine Zahl n heißt "ungerade", wenn n-1 gerade ist.
10:      return 0
11:          if (gerade($zahl-1));
12:      # Jede Zahl ist entweder "gerade" oder "ungerade".
13:      die "Die Zahl $zahl ist weder gerade noch ungerade.";
14:  };

• Probleme, die sich gut in gleichartige, aber kleinere Probleme teilen lassen

• Beispiel: Hierarchische Daten

• Dateisysteme

• HTML, XML

• LDAP-Verzeichnisse

• Größe eines Verzeichnisses ist die Summe der Größen aller Unterverzeichnisse und der Größen aller Dateien im aktuellen Verzeichnis

• Größe einer Datei wird von -s $file geliefert

 1:  use strict;
 2:  use File::Spec;
 3:  
 4:  # Aufruf:
 5:  print dir_size('.');

 1:  sub dir_size {
 2:      my ($dir) = @_;
 3:      my $dir_handle;
 4:      if (! opendir $dir_handle, $dir) {
 5:          warn "Konnte '$dir' nicht lesen: $!";
 6:          return 0
 7:      };

 1:      my $gesamt = 0;
 2:      for my $eintrag (readdir $dir_handle) {
 3:          next if $eintrag =~ /^\.{1,2}$/;
 4:          
 5:          if (-f File::Spec->catfile($dir,$eintrag)) {
 6:              #  Dateigröße aufaddieren
 7:              $gesamt += -s File::Spec->catfile($dir,$eintrag);

 1:          } else {
 2:              # Verzeichnis, Größe rekursiv holen
 3:              $gesamt += dir_size(File::Spec->catdir($dir,$eintrag));
 4:          }
 5:      };
 6:      return $gesamt;
 7:  }

Zielgerichtete Werkzeuge sind effizient

(Photo von itspaulkelly)

... aber anpassungsfähige Werkzeuge sind besser

Anpassung durch mitgegebenen Code.

Eingebaute, anpassbare Funktionen sind zum Beispiel:

 1:  sort  map  grep

 1:  my @mp3s = grep { 
 2:                    print "Prüfe $_\n"; 
 3:                    /\.mp3$/i 
 4:                  } @dateien;

dir_walk als Callback

 1:  Program 
 2:    -> dir_walk($callback, 'C:/') 
 3:         -> $callback->('C:/autoexec.bat')
 4:         -> $callback->('C:/config.sys')
 5:         ...
 6:         -> $callback->('C:/windows')
 7:         -> $callback->('C:/windows/system32')
 8:         ...

 1:  sub dir_walk {
 2:      my ($callback, $dir) = @_;
 3:      ...
 4:          if (-f File::Spec->catfile($dir,$eintrag)) {
 5:              # Callback aufrufen
 6:              $callback->(File::Spec->catfile($dir,$eintrag))

 1:          } else {
 2:              # Callback aufrufen
 3:              $callback->(File::Spec->catfile($dir,$eintrag));
 4:              # und absteigen
 5:              dir_walk($callback, File::Spec->catdir($dir,$eintrag))
 6:          }
 7:  }

Der folgende, naive Code funktioniert nicht immer - sobald dir_walk innerhalb von dir_walk aufgerufen wird, funktioniert er nicht mehr.

 1:    my $gesamt = 0;
 2:    sub collect_size { $gesamt += -s $_[0] };
 3:    dir_walk(\&collect_size, '.');
 4:    print "$gesamt\n";

So funktioniert der Code:

 1:    sub dir_size {
 2:        my ($dir) = @_;
 3:        my $gesamt = 0;
 4:        return dir_walk(sub { $gesamt += -s $_[0] }, $dir);
 5:    };

 1:    sub laengstes_mp3 {
 2:        my ($dir) = @_;
 3:        my ($name, $dauer);
 4:        dir_walk(sub { 
 5:          return if ($_[0] !~ /\.mp3$/i); # kein mp3
 6:          my $spieldauer = get_mp3_playlength($_[0]);
 7:          return if ($spieldauer <= $dauer); # zu kurz
 8:          $name = $_[0];
 9:        }, $dir);
10:        return $name;
11:    };

Ein weiteres Beispiel ist das Finden aller Dateien, die größer als eine bestimmte Datei sind:

 1:    sub groesser_als {
 2:        my ($file,$dir) = @_;
 3:        my $size = -s $file;
 4:        my @result;
 5:        dir_walk(sub{
 6:            push @result, $_[0]
 7:                if -f $_[0] and -s $_[0] > $size;
 8:        })
 9:        @result
10:    }

• File::Find funktioniert genau so.

• Nur besser (zumindestens oft)

• Ist bei jedem Perl dabei

Kleine Erweiterung von groesser_als:

Liefere den Namen der grössten Datei zurück:

 1:    sub ist_groesste_datei {
 2:        my ($file,$dir) = @_;
 3:        my @groessere_dateien = groesser_als($file,$dir);
 4:        @groessere_dateien == 0
 5:    };

Finde die groesste Datei:

 1:    sub groesste_datei {
 2:        my ($dir) = @_;
 3:        my $groesste;
 4:        dir_walk(sub{
 5:            $groesste = $_[0]
 6:                if ist_groesste_datei($_[0],$dir);
 7:        }, $dir);
 8:        return $groesste;
 9:    }

groesste_datei ist sicher nicht optimal:

 1:    /foo
 2:    /foo/bar.txt
 3:    /foo/baz.gz
 4:    /foo/zap.txt

• Zuerst wird /foo/bar.txt angeschaut; die Größe jeder Datei wird untersucht.

• Dann nochmal für /foo/baz.gz

• Dann nochmal für /foo/zap.txt

• Das geht schneller

• ... indem wir uns die Ergebnisse von groesser_als merken

• Caching ist eine einfache Idee

• Tausch: Arbeitsspeicher gegen Laufzeit

• Ein Cache einzubauen ist in Perl nicht schwer

 1:    {
 2:      my $real_groesser_als = \&groesser_als;
 3:      my %cache;
 4:      sub groesser_als_cached {
 5:        my ($file,$dir) = @_;

 1:        if (exists $cache{"$file\0$dir"}) {
 2:            # Wir kennen den Wert
 3:            return @{ $cache{"$file\0$dir"} }

 1:        } else {
 2:            # Wir kennen den Wert noch nicht
 3:            return $cache{"$file\0$dir"} 
 4:              = [ $real_groesser_als->($file,$dir) ]
 5:        }
 6:      }
 7:    }

 1:    # Cache installieren:
 2:    *groesser_als = \&groesser_als_cached;

• Keine neue Idee

• Aber eine sehr einfache Idee

• Und deshalb oft und viel verwendet

• Diese Methode des Cachings funktioniert für jede Funktion

• Außer für Funktionen, die für denselben Wert verschiedene Ergebnisse liefern

• Zum Beispiel time() und rand()

 1:    sub memoize {
 2:        my ($slow_code) = @_;
 3:        my %cache;
 4:        return sub {
 5:            my $key = join "\0", @_;
 6:            if (exists $cache{$key}) {
 7:                return $cache{$key}
 8:            } else {
 9:                return $cache{$key} = $slow_code->(@_)
10:            }
11:        }
12:    }

• Caching hilft nicht immer

• Man muß die richtigen Funktionen/Ergebnisse cachen

• Mit Memoize kann man das Cache an- und abschalten

• Der Name memoize kommt von der Lisp-Funktion.

 1:    *groesste_datei = memoize(\&groesste_datei);
 2:    
 3:    # oder
 4:    
 5:    use Memoize;
 6:    memoize('groesste_datei');
 7:    
 8:    # das ist alles

• Perl verwaltet den Speicher für uns

• Ganz automatisch und transparent

• $liste[ 10000 ] = 1;

my erzeugt eine lexikalische Bindung ("binding") eines Namens an einen Wert:

 1:  my $x = 3;

Eine Bindung besteht nur innerhalb des Sichtbarkeitsbereichs. Perl speichert die aktuell gültigen Bindungen in einer speziellen Datenstruktur, dem "Pad".

use strict; hilft, bei lexikalischen Variablen (my) die Bindungen zu überprüfen.

Sichtbarkeit hängt nur vom Quellcode ab:

• Klar bei globalen Variablen

• Auch klar bei lexikalischen Variablen

Lebensdauer von Werten und Sichtbarkeit von Bindungen sind nicht das selbe.

Datenstruktur in Zeile 4:

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Hier stimmen Lebensdauer und Sichtbarkeit überein.

Datenstruktur in Zeile 5 (Zwischenschritt):

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Datenstruktur in Zeile 5:

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Datenstruktur in Zeile 4:

 1:  my $r;
 2:  {
 3:      my $x = 3";
 4:      $r = \$x;
 5:  }

Datenstruktur in Zeile 5:

 1:  my $r;
 2:  {
 3:      my $x = 3";
 4:      $r = \$x;
 5:  }

 1:  my %self = ...;
 2:  return bless \%self, $class;

• Geht nicht mit C!

• Auto-Variable (bzw. Variable auf dem Stack) dürfen nicht nach dem return verwendet werden.

• In C: malloc / new / free

Für das allgemeine Cache sieht das Pad beim Aufruf aus wie folgt:

 1:  sub memoize {
 2:    my %cache;
 3:    my ($func) = @_;
 4:    return sub {
 5:        ...
 6:    };
 7:  };

 1:  my $groesser_als_c = memoize(\&groesser_als);

• Was passiert, wenn memoize zwei Mal aufgerufen wird?

   1:  my $x = memoize(groesser_als);
   2:  my $y = memoize(groesser_als);

• Alles in Ordnung - für jede anonyme Subroutine erstellt Perl ein eigenes Pad und packt es in den CV.

• Beim Aufruf wird das Pad aktiviert und die Subroutine sieht "ihre" Variablen (d.h. Bindungen).

Ein ganz simples Beispiel:

 1:  sub neuer_zaehler {
 2:      my ($n) = @_;
 3:      return sub {
 4:          print "n ist jetzt ",$n++,"\n";
 5:      };
 6:  }

 1:  my $x = neuer_zaehler(7);
 2:  my $y = neuer_zaehler(20);

 1:  $x->(); $x->(); $x->();
 2:  $y->(); $y->(); $y->();
 3:  
 4:  $x->(); $y->();

Das alles war nötig, nur um zu sehen, daß Memoize und Callbacks tatsächlich so funktionieren, wie wir das wollen.

• Natürlich funktioniert es.

• In C und anderen Sprachen mit weniger Dynamik funktioniert es nicht.

Bild: Staudamm?

• Callbacks haben ein Problem

• Hat man einen Callback-Mechanismus angestoßen,

• ... so ist es schwer, wieder aufzuhören

• Es gibt einen anderen Mechanismus, der die Daten stückweise auf Anfrage liefert.

• Diamant-Operator, <...>

• Ist in Perl eingebaut

• Eine Zeile pro Schleifendurchlauf

• Eigene Implementation

• Dateiunabhängig

• tie: Rel. schwierig, nicht effizient

• Funktionsaufruf:

   1:    sub mein_iterator { return $naechste_zeile };
   2:    
   3:    my $iterator = \&mein_iterator;
   4:    
   5:    print $iterator->(); # Aufruf

Dateihandle als Iterator:

 1:  sub witz {
 2:    open my $fh, "<", "witze.txt"
 3:      or die "Heute nichts zu lachen: $!";
 4:    return $fh
 5:  };

 1:  my $witz = witz();
 2:  while (<$witz>) {
 3:      print "Noch ein Witz:\n";
 4:      print "$_\n"; # Ha ha
 5:  };
 6:  # Applaus, Vorhang

Nachbau eines Iterators als Subroutine:

 1:  sub witz {
 2:    return 'Ein guter PHP Programmierer'
 3:  };

 1:  while (defined (local $_ = witz())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Applaus, Vorhang

Iteratoren als Variable:

 1:  my $witz = sub {
 2:    return 'Ein guter PHP Programmierer'
 3:  };

 1:  while (defined (local $_ = $witz->())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Nie Applaus, nie Vorhang

 1:  my @witze = (
 2:    'Ein guter PHP Programmierer',
 3:    'Die neue Version von Perl6',
 4:    'Ein lustiger Platzhalter',
 5:  );
 6:  my $witziger = sub {
 7:    return shift @witze;
 8:  };

 1:  while (defined ($_ = $witz->())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Applaus, Vorhang

open erstellt einen Datei-Iterator. mach_witze erstellt einen Witz-Iterator aus einer Liste:

 1:  sub mach_witze {
 2:      my @witze = @_;
 3:      return sub {
 4:          return shift @witze
 5:      }
 6:  }
 7:  
 8:  my $p_witze = mach_witze(
 9:    'Ein guter PHP Programmierer',
10:    'Die neue Version von Perl6',
11:    'Ein lustiger Platzhalter',
12:  );

Aus einer Liste machen wir oft Iteratoren, daher definieren wir:

 1:  sub list_iterator(@) {
 2:      my @items = @_;
 3:      return sub {
 4:        return shift @items;
 5:      } 
 6:  }

open erstellt einen Datei-Iterator. datei_witze erstellt einen Witz-Iterator aus einer Datei:

 1:  sub datei_witze {
 2:      my ($datei) = @_;
 3:      open my $fh, "<", $datei
 4:        or die "Nicht lustig: $!";
 5:      my @witze = chomp <$fh>;
 6:      return sub {
 7:          return shift @witze
 8:      }
 9:  }
10:  
11:  my $alte_huete = datei_witze('best_of_1920.txt');

• Ausgabe von Iteratoren ist mühsam

• Generische Routine:

 1:  sub output {
 2:      my ($iterator) = @_;
 3:      while (defined (local $_ = $iterator->())) {
 4:          print "$_\n";
 5:      }
 6:  }
 7:  
 8:  output( mach_witze( 'perl6.txt' ));

 1:  # ...
 2:  # ...
 3:  # ...

• Iteratoren liefern immer nur ein Element, statt alle Elemente auf einen Schlag.

• Potentiell unendliche Listen sind möglich:

 1:    sub zaehler {
 2:        my $n = $_[0] || 1;
 3:        return sub {
 4:            return $n++
 5:        }
 6:    }

 1:    my $zahlen = zaehler();
 2:    output( $zahlen );
 3:    # 1
 4:    # 2
 5:    # 3
 6:    # 4
 7:    # ...
 8:    # bzw. Hitzetod des Universums

• Nicht alle Zahlen sind interessant

• Nur gerade Zahlen sind interessant

 1:    sub filter(&$) {
 2:        my ($filter,$i) = @_;
 3:        return sub {
 4:            local $_;
 5:            while (defined (local $_ = $i->())) {
 6:                return $_
 7:                    if $filter->();
 8:            };
 9:            return ()
10:        }
11:    }

filter heißt in Perl grep, aber grep funktioniert nur auf Listen, nicht auf Iteratoren

 1:    my $gerade = filter { $_ % 2 == 1 } $zahlen;
 2:    output( $gerade );
 3:    # 2
 4:    # 4
 5:    # 6
 6:    # 8
 7:    # 10
 8:    # ...

Wir können also auch mit unendlichen Mengen arbeiten, solange wir sie nicht auf den Bildschirm ausgeben, oder sonstwie zum Ende der Liste gehen wollen.

Das Verbindungssteckergesetz

• Jedes Interface ist maximal unbrauchbar

• a) Iterator zu Callbacks

• b) Callback zu Iterator

Iterator zu Callback - ganz einfach:

 1:  sub for_iterator {
 2:      my ($iterator,$callback) = @_;
 3:      while (defined my $val = $iterator->()) {
 4:          $callback->($val)
 5:      }
 6:  };

 1:  for_iterator(mach_witze('stefan_raab.txt'), sub { 
 2:    print $_[0]
 3:  });

Callback zu Iterator - nicht immer einfach.

"Mund voller Kirschkerne"-Ansatz:

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      my @dateien;
 4:      
 5:      # Das dauert:
 6:      dir_walk($dir,sub { push @dateien, $_[0] });

 1:      return list_iterator { @dateien };
 2:  }

Verwendung des Iterators

 1:  my $dateien = dir_walk_iter('.');
 2:  while (defined my $datei = $dateien->()) {
 3:      print "$datei\n";
 4:  }

• Kein Laufzeitgewinn

• Kein Gewinn, wenn man nicht alle Dateinamen braucht

• Alles lesen ist nicht faul

• Alternative 1: zweiter Prozeß mit Dateihandle

• Alternative 2: Eigener Code

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      open my $fh, "find '$dir' |"
 4:          or die "$dir: $!";
 5:      return sub {
 6:          eof $fh ? () : <$fh>
 7:      }
 8:  }

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      my $cmd = q{$^X -MFile::Find -le }
 4:              . q{"find(sub{print$File::Find::name},@ARGV);}
 5:              . qq{END{warn 'Einlesen fertig.'}" $dir |};
 6:      warn $cmd;
 7:      open my $fh, $cmd
 8:          or die "$dir: $!";
 9:      return sub {
10:          #local $/ = \0;
11:          my $res = <$fh>;
12:          chomp $res;
13:          return defined $res ? $res : () 
14:      }
15:  }

Vorteile

• Multitasking

• Echtes Filehandle

• Abgeschotteter Prozeß

Nachteile

• Keine feine Fehlerkontrolle

• Abgeschotteter Prozeß

• Schwierig echt portabel zu halten

• "Fauler" Iterator

• Merkt sich, was noch zu tun ist

• Tut aber nur das nötigste

• Merke Dir alle Einträge im aktuellen Verzeichnis

• Wenn der aktuelle Eintrag ein Verzeichnis ist, liefere den Namen zurück, und ersetze den Verzeichnisnamen durch alle Einträge im Unterverzeichnis

• Wenn der aktuelle Eintrag eine Datei ist, liefere den Dateinamen zurück und vergiß die Datei

• Wenn die Liste leer ist, liefere ebenfalls die leere Liste zurück

 1:    sub dir_walk {
 2:        my ($cb, @dirs) = @_;
 3:        my @agenda = @dirs;
 4:        return sub {
 5:            my $eintrag = shift @agenda;
 6:            
 7:            if (-d $eintrag) {
 8:                print "*** Lese $eintrag ein\n";
 9:                opendir my $dh, $eintrag
10:                    or die "$eintrag: $!";
11:                my @eintraege = grep { /^\.\.?$/ } 
12:                    readdir $dh;
13:                unshift @agenda, map { "$eintrag/$_" }
14:                  @eintraege;
15:            };
16:            return $eintrag;
17:        }
18:    }

 1:    output( dir_walk( 'C:\.cpan\build\Catalyst-5.64\' ));
 2:    # ...
 3:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin ein
 4:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin
 5:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader ein
 6:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader
 7:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader\YAML.pm
 8:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader.pm
 9:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\Static ein
10:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\Static

 1:    sub mp3s {
 2:        return filter { /\.mp3$/i } dir_walk @_;
 3:    };
 4:    
 5:    output(mp3s);

• Dateien können groß werden

• Uns interessiert immer nur eine Zeile zur selben Zeit

• Zum Beispiel bei Log-Dateien

 1:    sub zeilen {
 2:        my ($fh) = @_;
 3:        
 4:        # merken, wo wir waren
 5:        my $pos = tell $fh;
 6:        
 7:        return sub {
 8:            seek $fh, $pos, 0;
 9:            my $line = <$fh>;
10:            $pos = tell $fh;
11:            return $line;
12:        }
13:    }

• Warum?

• Beispiel: Sessions live verfolgen

• Nicht alle gestarteten Sessions enden auch

• Wir merken uns alle "laufenden" Sessions

 1:    http://datenzoo.de/session/start/1 10:00
 2:    http://datenzoo.de/session/start/2 10:01
 3:    http://datenzoo.de/session/start/3 10:05
 4:    http://datenzoo.de/session/start/4 10:15
 5:    http://datenzoo.de/session/stop/3  10:16
 6:    http://datenzoo.de/session/stop/4  10:30
 7:    http://datenzoo.de/session/stop/1  10:55
 8:    (Timeout von Session 2)            11:01

Das Hauptprogramm soll den Filter in einer einfachen Schleife verwenden können:

 1:  while (my ($nr,$start,$ende) = $session->())) {
 2:      print "Session $nr beendet ($start-$ende)";
 3:  }

 1:    sub session_finished {
 2:        my ($zeilen) = @_;
 3:        my %offen;
 4:        return sub {
 5:            while (defined (local $_ = $zeilen->()) {
 6:                if (m!/start/(\d)\s+(\d+:\d+)$!) {
 7:                    $offen{$1} = $2;
 8:                };
 9:                if (m!/stop/(\d)\s+(\d+:\d+)$!) {
10:                    if ($offen{$1}) {
11:                        delete $offen{$1};
12:                        return [$1, $offen{$1}, $2];
13:                    }
14:                }
15:            }
16:        }
17:    }

 1:    output session_finished zeilen \*DATA;

• session_finished liefert uns die Sessions in Reihenfolge des Endes

• Wir wollen die Sessions anders sortieren, z.B. nach Reihenfolge der Eröffnung

• Was ist mit Sessions, die nie enden?

• => Timeout von 1h - alle Sessions enden nach 1h

• "cutsort" zum Sortieren unendlicher Listen

 1:  sub nach_start {
 2:      my ($sessions) = @_;
 3:      my @ausgeben;
 4:      my @beendete_sessions;
 5:      return sub {
 6:        if (! @ausgeben) {
 7:          while (my $s = $sessions->()) {
 8:            while (@beendete_sessions 
 9:                    && $s->[1] > $beendete_sessions[0]) {
10:                push @ausgeben, shift @beendete_sessions;
11:            };
12:            @pending = sort { $a->[1] cmp $b->[1] } (@pending,$s);
13:          }
14:        };
15:        return shift @ausgeben
16:          if (@ausgeben);
17:      };
18:  }

Fragen?